PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/pleas/ole/visio/network/visreg.bas

BASIC Source File | 1994-05-18 | 14.9 KB | 441 lines

'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'--
'--                   Visio Instance Registration Utilites
'--                       (C)1993 Shapeware Corporation
'--
'--   File Name : visreg.bas
'--
'-- Description : Contains helper functions for working with Visio instances.
'--               To use this module include it into your project and use one
'--               of the three levels available.  For more information see
'--               below.
'--
'--               The registration utility offers an easy way get and create
'--               Visio instance objects.  It offers three levels of instancing
'--               from simple get/create/release to registration where the
'--               library maintains the "signature" of a Visio instance and
'--               warns you when the active instance changes.
'--
'--               The library maintains a static global g_appVisio which
'--               is called the global instance object (GIO).  Use GIO in
'--               your code when refering to the working instance of Visio.
'--               Never apply the Set operator to GIO yourself (unless you
'--               really know what your doing).
'--
'--               To use the library, include it in your project and refer the
'--               visio application object through g_appVisio (GIO).
'--               Read the sections below to find the level of functionality
'--               you want.
'--
'--               Low Level Routines
'--
'--               The low level routines are almost identical to what you
'--               would use normally with GetObject and CreateObject.
'--               However they encapsulate the error handling.
'--
'--                   vaoGetGIO()     Retrieves active, running instances.
'--                   vaoCreateGIO()  Creates a new instance.
'--                   vaoReleaseGIO() Release the GIO instance if Set.
'--                   vaoIsGIOValid() Verifies that GIO is Set and loaded.
'--
'--               Registration/Release Level
'--
'--                   Use this level when you need the registration functions
'--                   to maintain the GIO but want control over how it is
'--                   obtained.  The procedures are:
'--
'--                       vaoRegisterGIO()
'--                       vaoUnRegistrGIO()
'--                       vaoReSetGIO()
'--                       (vaoReleaseGIO()    [From low level])
'--
'--                   To begin you register your instance and choose how to
'--                   retrieve the GIO (Get/Create/Both) with
'--                   vaoRegisterGIO() and use vaoUnRegisterGIO to release
'--                   it.  This gives a good amount of flexibility but leaves
'--                   it up to you to handle the conditions where Visio is shut
'--                   down or a new instance is loaded.  At this level you keep
'--                   the instance registered but release the GIO using
'--                   vaoReleaseGIO.  To get back GIO use vaoReSetGIO.
'--
'--               Most Common Level
'--
'--                   This is highest, most abstract level.  It's called Most
'--                   Common level because most scripts will probably use it
'--                   to get instance objects.  There is one function:
'--
'--                       vaoGetObject()
'--
'--                   When called it will check to see if the GIO is already
'--                   registered.  If not it will first attempt a GetObject
'--                   and, if that fails, will use CreateObject.  Unless Visio
'--                   is not installed, you will get visOK back.  On subsequent
'--                   calls it checks that it is still valid (not UnSet and
'--                   still running).  If so it returns visOK, otherwise it
'--                   tries to register the GIO again.  If that fails you
'--                   receive visError.  The nice thing about this is that one
'--                   call maintains the GIO for you.
'--
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------

Option Explicit                                 '-- All Variable Explicit!

Global g_appVisio As object

Const REG_GET_HWND = 1
Const REG_SET_HWND = 2

Global Const visDiffInst = 1
Global Const visGet = 2
Global Const visCreate = 3
Global Const visVisioQuit = 4
Global Const visError = 5
Global Const visRegistered = 6
Global Const visOK = 7

Private Function GetHWND ()
'-------------------------------
'--- GetHWND -------------------
'--
'--   Returns the registered Visio Window Handle.
'--

    Dim iTemp As Integer

    VisWindowHandle REG_GET_HWND, iTemp

    GetHWND = iTemp
End Function

Private Function Registered () As Integer
'-------------------------------
'--- RegisterVisio -------------
'--
'--   Returns boolean integer indicating if we are registered or not.
'--

    Registered = (GetHWND() <> 0)
End Function

Private Sub SetHWND (ByVal iNewHWND As Integer)
'-------------------------------
'--- SetHWND -------------------
'--
'--   Sets the registered Visio Window Handle.
'--

    VisWindowHandle REG_SET_HWND, iNewHWND
End Sub

Function vaoCreateGIO () As Integer
'-------------------------------
'--- vaoCreateGIO --------------
'--
'--   Uses CreateObject to create a new instance of Visio.  If it fails
'-- False is returned, otherwise the GIO is set to the instance created
'-- and True is returned.
'--

    On Error GoTo vaoCreateGIOErrorHandler

    Debug.Print "VISREG.BAS vaoCreateGIO() - Creating new Visio instance."

    Set g_appVisio = CreateObject("visio.application")

    If Not (g_appVisio Is Nothing) Then
    vaoCreateGIO = True
    End If

    Exit Function

vaoCreateGIOErrorHandler:
    Debug.Print "VISREG.BAS vaoCreateGIO() - Failed."
    Exit Function
    Resume Next
End Function

Function vaoGetGIO () As Integer
'-------------------------------
'--- vaoGetGIO -----------------
'--
'--   Uses GetObject to get the active instance of Visio.  If GetObject fails
'-- False is returned, otherwise the GIO is set and True is returned.
'--

    On Error GoTo vaoGetErrorHandler

    Debug.Print "VISREG.BAS vaoGetGIO() - Retrieving active Visio instance."

    Set g_appVisio = GetObject(, "visio.application")

    If Not (g_appVisio Is Nothing) Then
    vaoGetGIO = True
    End If

    Exit Function

vaoGetErrorHandler:
    Debug.Print "VISREG.BAS vaoGetGIO() - Failed."
    Exit Function
    Resume Next
End Function

Function vaoGetObject () As Integer
'-------------------------------
'--- vaoGetObject --------------
'--
'--   Uses registration procedures to maintain the GIO.  This funciton makes
'-- up the Common Use Layer (most commonly used procedure) for using the GIO.
'-- Just call it every time you need to work with Visio and it will make sure
'-- you have a valid working copy.
'--
'-- Return Values:
'--  visOK        - The GIO is set to a valid working instance of Visio.
'--  visError     - Visio 2.0 or OLE not installed or some other serious
'--                 error occurred.
'--

    Dim iRetVal As Integer, iTemp As Integer, l_appVisio As object

    iRetVal = visOK                             '-- Default To OK

    If Registered() Then                        '-- When Registerd...
    If Not vaoIsGIOValid() Then             '--   If GIO Is Valid...
        Debug.Print "VISREG.BAS vaoGetObject() - Re-registering instance."

        '-- Somehow the GIO is no longer valid, either because it was
        '-- vaoReleaseGIO'd or is no longer running.  Therefore we just
        '-- try to re-register and if the same instance is active, we
        '-- get that one again.  Otherwise we end up with the active
        '-- instance of Visio or a newly created one.
        '--
        '-- In future versions of Visio we will iterate through the
        '-- instance collection and retrieve the instance we originally
        '-- registered to if it still exists.

        vaoUnRegisterGIO                    '--   Oops, Its Bad Now...

        If vaoRegisterGIO(True, True) = visError Then
        iRetVal = visError
        End If
    End If
    Else
    If vaoRegisterGIO(True, True) = visError Then iRetVal = visError
    End If

    vaoGetObject = iRetVal
End Function

Function vaoGetVisio (bGet As Integer, bCreate As Integer) As Integer
'-------------------------------
'--- vaoGetVisio ---------------
'--
'--   Identical to vaoRegisterGIO except doesn't use registration functions.
'--
'-- Parameters : bUseExisting - Boolean - Use vaoGetGIO() first.
'--              bCreate      - Boolean - Use vaoCreateGIO().
'--
'--    Returns : visError     - If an error occurred and the GIO could not be
'--                             set.  Either the flags were invalid or
'--                             Get & Create failed.
'--              visGet       - When a vaoGetGIO() retrieved the GIO.
'--              visCreate    - When a vaoCreateGIO() retrieved the GIO.
'--              visRegisterd - Failed - GIO is registered.  Use
'--                             vaoUnRegisterGIO().
'--

    Dim iRetVal As Integer

    ' If registered we fail.
    '
    If Registered() Then
    iRetVal = visRegistered
    GoTo lblGetVisioCleanUp
    End If

    iRetVal = visError

    ' If the Get flag was set we first try vaoGetGIO()
    '
    If bGet Then
    If vaoGetGIO() Then iRetVal = visGet
    End If

    ' If the Create flag is on and the return value doesn't indicate that
    ' a get worked then we use create.
    '
    If bCreate And (iRetVal <> visGet) Then
    If vaoCreateGIO() Then iRetVal = visCreate
    End If

    ' If the GIO isn't set at this point we output an error message.
    '
    If g_appVisio Is Nothing Then
    Debug.Print "VISREG.BAS vaoRegisterGIO() - Error registering GIO."
    End If

lblGetVisioCleanUp:
    vaoGetVisio = iRetVal
End Function

Function vaoIsGIOValid () As Integer
'-------------------------------
'--- vaoIsGIOValid -------------
'--
'--   Our validity test simply checks to see if the GIO is set and, if so,
'-- checks if it is loaded.
'--
'-- Returns : True if GIO is set and loaded, False otherwise.
'--
    On Error GoTo lblvaoGIOValidErr

    Dim iTemp As Integer

    vaoIsGIOValid = False                           '-- Default To False

    If (g_appVisio Is Nothing) Then Exit Function   '-- Not Set

    iTemp = g_appVisio.Documents.Count              '-- Try A Property

    vaoIsGIOValid = True                            '-- No Error - Valid!
    Exit Function

lblvaoGIOValidErr:
    Exit Function                                   '-- Error - Invalid
    Resume Next
End Function

Function vaoRegisterGIO (bUseExisting As Integer, bCreate As Integer) As Integer
'-------------------------------
'--- vaoRegisterGIO ------------
'--
'--   Registers the GIO using two parameters to decide how the Visio instance
'-- should be created.  Use vaoUnRegisterGIO to reverse the registration.
'--
'-- Parameters : bUseExisting - If True then GetObject will tried first.
'--              bCreate      - If True CreateObject will be called after
'--                             any GetObject calls.
'--
'--    Returns : visError     - If an error occurred and the GIO could not be
'--                             registered because either the flags passed
'--                             were invalid or Get & Create failed.
'--              visGet       - When a GetObject retrieved the GIO.
'--              visCreate    - When a CreateObject retrieved the GIO.
'--              visRegisterd - When already registered.
'--

    Dim iRetVal As Integer

    If Registered() Then
    iRetVal = visRegistered
    GoTo lblRegisterCleanUp
    End If

    iRetVal = visError

    If bUseExisting Then
    If vaoGetGIO() Then iRetVal = visGet
    End If

    If bCreate And (iRetVal <> visGet) Then
    If vaoCreateGIO() Then iRetVal = visCreate
    End If

    If g_appVisio Is Nothing Then
    Debug.Print "VISREG.BAS vaoRegisterGIO() - Error registering GIO."
    Else
    SetHWND g_appVisio.WindowHandle
    End If

lblRegisterCleanUp:
    vaoRegisterGIO = iRetVal
End Function

Sub vaoReleaseGIO ()
'-------------------------------
'--- vaoReleaseGIO -------------
'--
'--   Handles releasing the GIO.  Does not unregister the window handle.
'-- If using the registration interfaces use vaoReSetGIO to retrieve the
'-- GIO, otherwise you may use vaoGetGIO or vaoCreateGIO.  This does not
'-- take affect until all other references go out of scope.
'--

    Set g_appVisio = Nothing                '-- Release Resources

    Debug.Print "VISREG.BAS vaoReleaseGIO() - Complete."
End Sub

Function vaoReSetGIO () As Integer
'-------------------------------
'--- vaoReSetGIO ---------------
'--
'--   Tries to re-Set the GIO only if we are registered and the GIO is not
'-- already set.
'--
'-- Return Values :
'--   visError     - If not registered or GIO is already set.
'--   visOK        - If able to reSet the GIO to the registered instance.
'--   visVisioQuit - If Visio is no longer running.  If so then the GIO is
'--                  unregistered because the HWND is no longer valid.
'--   visDiffInst  - If the registered instance is no longer running.  The
'--                  GIO is not set.
'--

    vaoReSetGIO = visError

    If Not Registered() Or Not (g_appVisio Is Nothing) Then Exit Function

    If vaoGetGIO() Then
    If g_appVisio.WindowHandle = GetHWND() Then
        vaoReSetGIO = visOK
    Else
        vaoReleaseGIO
        vaoReSetGIO = visDiffInst       '-- Release GIO
    End If
    Else
    vaoReSetGIO = visVisioQuit
    vaoUnRegisterGIO                    '-- UnRegister
    End If
End Function

Sub vaoUnRegisterGIO ()
'-------------------------------
'--- vaoUnRegisterGIO ----------
'--
'--   Unregisters a visio instance by clearing the window handle and releasing
'-- the global instance object.
'--

    SetHWND 0                           '-- Resets HWND
    vaoReleaseGIO                       '-- Releases GIO

    Debug.Print "VISREG.BAS vaoUnRegisterGIO() - Completed."
End Sub

Private Sub VisWindowHandle (ByVal iAction As Integer, iArg As Integer)
'-------------------------------
'--- VisWindowHandle -----------
'--
'--   Maintains the registered window handle in a static variable.
'--
'-- Parameters : iAction - Specifies the action to perform.  REG_GET_HWND
'--                        sets iArg to the handle.  REG_SET_HWND sets the
'--                        handle to iArg.
'--
'--              iArg    - Used in gets/sets.
'--

    Static iHWND As Integer

    Select Case iAction
    Case REG_GET_HWND: iArg = iHWND
    Case REG_SET_HWND: iHWND = iArg
    Case Else:
        Debug.Print "VISREG.BAS VisWindowHandle() - Invalid Action Passed"
    End Select
End Sub